home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / roller / roller1.bas < prev    next >
BASIC Source File  |  1994-08-11  |  5KB  |  142 lines

  1. 'ROLLER1.BAS
  2. '
  3. 'By Timothy J. Mitchell, CompuServe 71461,303
  4. '
  5. 'Last Modified 26June94
  6. '
  7. 'This module was inspired by the VISUAL BASIC WORKSHOP column in the May 1994
  8. 'issue of Britain's PC PLUS magazine (pg 296), which introduced me to the joys
  9. 'of the BitBlt API call.
  10. '
  11. 'To use the Dice, place the dice bitmap (dice.bmp) in a PictureBox on the
  12. 'form. You can hide it by pulling the side of the form over it (see
  13. 'Roller1.FRM) in the example. Place more PictureBoxes on the form, one for
  14. 'each of the die you want to show.
  15. '
  16. 'Display the dice by calling the following subroutine:
  17. '
  18. 'ShowDie (Source, Target, Digit, Color)
  19. '
  20. '   where   Source is the PictureBox containing the Dice Bitmap (dice.bmp)
  21. '           Target is the PictureBox that will contain the displayed die
  22. '           Digit is an integer between 1 and 6 referring to the die face
  23. '           Color is an integer between 1 and 3 referring to the die color
  24. '
  25. '
  26. 'To use the Numbers, place the Number bitmap (Num.bmp) in a PictureBox on
  27. 'the form. You can hide it by pulling the side of the form over it (see
  28. 'Roller1.FRM) in the example. place more PictureBoxes on the form, one for
  29. 'each Digit you want to show.
  30. '
  31. 'Display the numbers by calling the following subroutine:
  32. '
  33. 'ShowNum (Source, Target, Digit, Color)
  34. '
  35. '   where   Source is the PictureBox containing the Number Bitmap (num.bmp)
  36. '           Target is the PictureBox that will contain the displayed digit
  37. '           Digit is an integer between 0 and 9 referring to the value
  38. '           Color is an integer between 1 and 3 referring to the color
  39. '
  40. '
  41. ' Note: Make sure you set the AUTOREDRAW property of the hidden
  42. ' PictureBox(es) to TRUE or the graphics repaints won't work correctly.
  43. '
  44. Option Explicit
  45.  
  46. 'Declare API call BitBlt
  47.  
  48. Global Const SRCCOPY = &HCC0020
  49. Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
  50.  
  51. Global res As Integer  'Holder for Funtion BitBlt result
  52.  
  53. Sub RollDice (DiePic As PictureBox, Color As Integer, Die1 As PictureBox, Die2 As PictureBox, Die3 As PictureBox, Die4 As PictureBox, Die5 As PictureBox)
  54. '
  55. 'Rolls a set of 5 dice by randomly determining the result and
  56. 'calling Sub ShowDie
  57. '
  58.     Dim A As Integer   'Holders for randomly generated numbvers
  59.     Dim B As Integer
  60.     Dim C As Integer
  61.     Dim D As Integer
  62.     Dim E As Integer
  63.     
  64.     Randomize               'get a random number between 1 and 6 for each
  65.     A = Int(6 * Rnd + 1)    'die
  66.     Randomize
  67.     B = Int(6 * Rnd + 1)
  68.     Randomize
  69.     C = Int(6 * Rnd + 1)
  70.     Randomize
  71.     D = Int(6 * Rnd + 1)
  72.     Randomize
  73.     E = Int(6 * Rnd + 1)
  74.  
  75.     ShowDie DiePic, Die1, A, Color 'update the contents of each
  76.     ShowDie DiePic, Die2, B, Color 'die picture box
  77.     ShowDie DiePic, Die3, C, Color
  78.     ShowDie DiePic, Die4, D, Color
  79.     ShowDie DiePic, Die5, E, Color
  80.                                     
  81. End Sub
  82.  
  83. Sub RollNum (NumPic As PictureBox, Color As Integer, Num1 As PictureBox, Num2 As PictureBox, Num3 As PictureBox, Num4 As PictureBox, Num5 As PictureBox)
  84. '
  85. 'Determines a set of 5 randomly determined numbers and displays them by
  86. 'calling Sub ShowDie
  87. '
  88.     Dim A As Integer       'Holder for random number
  89.     Dim B As Integer
  90.     Dim C As Integer
  91.     Dim D As Integer
  92.     Dim E As Integer
  93.  
  94.     Randomize                'generate random numbers
  95.     A = Int(10 * Rnd + 1)
  96.     Randomize
  97.     B = Int(10 * Rnd + 1)
  98.     Randomize
  99.     C = Int(10 * Rnd + 1)
  100.     Randomize
  101.     D = Int(10 * Rnd + 1)
  102.     Randomize
  103.     E = Int(10 * Rnd + 1)
  104.  
  105.     ShowNum NumPic, Num1, A, Color   'update contents of the five num
  106.     ShowNum NumPic, Num2, B, Color   'picture boxes
  107.     ShowNum NumPic, Num3, C, Color
  108.     ShowNum NumPic, Num4, D, Color
  109.     ShowNum NumPic, Num5, E, Color
  110.  
  111.     
  112. End Sub
  113.  
  114. Sub ShowDie (Source As PictureBox, Target As PictureBox, Digit As Integer, Color As Integer)
  115.     '
  116.     'this subroutine clips a die face from the bitmap in SOURCE and
  117.     'puts it in TARGET
  118.     'PLEASE note that these two Parameters are reversed from Sub ShowNum because
  119.     'the two SOURCE bitmaps are oriented differently. That is, the dice bitmap
  120.     'is set up with the colors accross the top and the numbers down and the
  121.     'number bitmap the opposite way.
  122.     '                                                  |---------------| |---------------|
  123.     res = BitBlt(Target.hDC, 0, 0, 32, 32, Source.hDC, 32 * (Color - 1), 32 * (Digit - 1), SRCCOPY)
  124.     Target.Refresh
  125.  
  126. End Sub
  127.  
  128. Sub ShowNum (Source As PictureBox, Target As PictureBox, Digit As Integer, Color As Integer)
  129.     '
  130.     'this subroutine clips a number from the bitmap in SOURCE and
  131.     'puts it in TARGET
  132.     'PLEASE note that these two Parameters are reversed from Sub ShowDie because
  133.     'the two SOURCE bitmaps are oriented differently. That is, the dice bitmap
  134.     'is set up with the colors accross the top and the numbers down and the
  135.     'number bitmap the opposite way.
  136.     '                                                  |---------------| |---------------|
  137.     res = BitBlt(Target.hDC, 0, 0, 13, 23, Source.hDC, 13 * (Digit - 1), 23 * (Color - 1), SRCCOPY)
  138.     Target.Refresh
  139.  
  140. End Sub
  141.  
  142.